COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE WRTPAG
C00016 ENDMK
C⊗;
	SUBROUTINE WRTPAG
	DATA SLSP/12.0/
	COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
	1 /SF/KL,RT,KP,STFSZ,NAMX,EXT /IPG/IPG
	1 ,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) 
	1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(515)
 	1 /RCLF/KK,CL,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,ITR
	COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
	COMMON/STF/RSTFAC(0/7),RSTJ2 /IVV/IV(1) /KNUM/KNUM
	COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(1)
	DIMENSION ENDSTF(450),KPTR(50)
C  ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R7,RQ(5))
	1,(R8,RQ(6)),(LCNT,IV(45)),(NDPY,IV(46)),(ENDSTF,KBAR(4))
	NPG=1
	NMPG='PAGEA'
	HORZ=96.
	IF(KNUM.GT.0)KNUM=KNUM-1
C FOR PAGE NUMS.
	IF(MOD(KNUM,2).NE.0)HORZ=-HORZ
	RNUM=0.+KNUM
	LB=0
	ITR=LL
C TRANSPOSE IS IN LL
	RA=0
	JEND=-1
	METR=1000
	CLEF=-99
	JSLUR=0
	LC=1
	KREAD=128
	SIG=CLEF
	HX=2
	KQ=1
	KPX=1
	CALL FILOUT
C NAMQ AND NPG ARE SET IN FILOUT  
	SP=2.45
C  DEFAULT VERT. SPACE UNITS
	ENDSTF(1)=0
	IF(N.EQ.0)GO TO 100
C  SPACED OUT DEPENDING ON NUM OF LINES
	HX=N
	SP=SP+(HX-2.)*.11

100	CALL FILEIN

320	CALL STAVES
CC	IF(IPG)GO TO 3000
	IF(NPG.NE.1)GO TO 3000
	RT=RSTNUM(JPG)
	RS=100.+HORZ
	HORZ=-HORZ
	RNUM=RNUM+1
C ADDS PAGE NUMBER.
	CALL STAFF(4.,10.,RS,28.,RNUM,1.1,0,0,0,0,0,0)
3000	IF(ITR.NE.0)CALL TRNSP
	JPQ=KL

	NA=0
	KPT=1
	ENDSTF(1)=0
C  LOOP STARTS HERE *******
131	NA=NA+1
	KWDS(KP)=JPQ
	KP=KP+1
	R=CODEN(KPN,NA,Q,JK)
	RR=Q(JK+6)
	RS=Q(JK)
	IF(R.NE.5)GO TO 935
	R8=-1
	IF(RS.GE.6)R8=Q(JK+8)
	IF(RR)GO TO 735
	IF(RR.LE.Q(JK+3))RR=202.
	GO TO 235
C CATCHES SLURS, TRILLS, 8VA, LINES THAT GO PAST END OF LINE.
935	IF(R.EQ.7)GO TO 835
	IF(R.NE.44)GO TO 35
	R=R/11.
	Q(JK+1)=R
C  INFOR FOR P9 AND L10 OF DASHES AND WIGGLES NOT KEPT YET!!!!!!!
	IF(RR.LT.Q(JK+3))GO TO 30
C  NEEDED WHEN DATA ON LINE HAS BEEN EXPANDED, NOT CONTRACTED.
835	R8=0
	R7=0
	IF(RS.GE.6)R8=Q(JK+8)
235	IF(RR.LT.199.)GO TO 30
C  P1,P2,P3,P4,P5,P6,P7,P8  ARE SAVED.
	RR=-1
735	IF(RS.GE.5)R7=Q(JK+7)
	ENDSTF(KPT)=6
	ENDSTF(KPT+1)=R
	C=Q(JK+2)
	ENDSTF(KPT+2)=C
	ENDSTF(KPT+3)=1
	ENDSTF(KPT+4)=Q(JK+4)
	ENDSTF(KPT+5)=Q(JK+5)
	ENDSTF(KPT+7)=R7
	ENDSTF(KPT+8)=R8
 	ENDSTF(KPT+6)=RR
CX	A=Q(JK+6)
CX	B=0
CX	R7=0
CX	DO 136 K=NA+1,NPX
C THIS LOOP GETS NOTE POS. OF RIGHT SIDE OF SLUR.
CX	KK=KPN(K)
CX	R=Q(KK+1)
CX	IF(R.NE.1)GO TO 136
CX	IF(C.NE.Q(KK+2))GO TO 136
CX	B=B+1
CX	R8=Q(KK+3)
C FIND NOTE BEFORE AND AFTER RIGHT END OF SLUR
CX	IF(R8.LE.A)GO TO 336 
CX	ENDSTF(KPT+6)=-B+(R8-A)/(R8-R7)
C SAVE NEG. NOTE COUNT.  POSITIVE WILL ALWAYS BE 12.
CX	GO TO 236
CX336	R7=R8
C  FIND POS OF NOTE JUST BEFORE POINT.
CX136	CONTINUE

236	KPT=KPT+13
	ENDSTF(KPT)=0
	Q(JK+6)=202
	GO TO 30
C*************
35	IF(R.NE.2)GO TO 36
	IF(RS.LT.6.)GO TO 30
CC	R=Q(JK+2)
C  THE STAFF NUM.
CC	DO 134 K=NA-1,1,-1
CC	R8=CODEN(KPN,K,Q,LL)
CC	IF(R8.EQ.4)GO TO 234
CC	IF(Q(LL+2).NE.R)GO TO 134
CC	IF(R8.LT.10)GO TO 234
CC134 	CONTINUE
C NOW FOUND ITEM TO LEFT ON THIS STAFF.
CC234	RR=Q(LL+3)
CC	DO 334 K=NA+1,I
CC	R8=CODEN(KPN,K,Q,LL)
CC	IF(R8.EQ.4)GO TO 434
CC	IF(Q(LL+2).NE.R)GO TO 334
CC	IF(R8.LT.10)GO TO 434
CC334 	CONTINUE
CC434	RS=Q(LL+3)
C NOW FOUND ITEM TO RIGHT ON THIS STAFF.

	RR=RIGHT(NA,-1,JK)
CR	IF(RR.GE.199.)RR=RX
	Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1,JK)-RR)/2.
C  FUNCTION 'RIGHT' FINDS ITEMS TO LFT AND RT OF REST FOR CENTERING.
C CENTERS WHOLE REST
	GO TO 30
36	IF(R.NE.3)GO TO 34
	CLEF=CLEFN(Q,JK)
CPT	IF(IPG)GO TO 30  
	LL=Q(JK+2)
C GETS CLEF FOR PAGE LAYOUT
	RCLEF(LL)=CLEF
	GO TO 30
34	IF(R.NE.17)GO TO 37
	SIG=Q(JK+5)
	IF(ABS(SIG).GT.100.)SIG=-99
C  DO NOT REPEAT KSIG MADE UP OF NATURALS.
CXX	IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
CXX  CLEF # IN P6 WITH KEY SIGS.
C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
37	IF(R.LT.33)GO TO 130
38	Q(JK+1)=R/11.
	GO TO 30
130	IF(Q(JK+3).LT.199)GO TO 30
	IF(R.NE.18)GO TO 30
	KKK=K+1
	R3=9
	IF(SIG.NE.-99)R3=14
	KK=JK
CC435	R8=0
CC	R9=0
CC	R10=0
435	LL=KPN(KKK)
C  WDCNT,P1,P2,P3,P4,P5,P6,P7,P8
	ENDSTF(KPT)=Q(KK)
	ENDSTF(KPT+1)=R
	ENDSTF(KPT+2)=Q(KK+2)
	ENDSTF(KPT+3)=R3
CC	ENDSTF(KPT+4)=Q(KK+4)
CC	ENDSTF(KPT+5)=Q(KK+5)
CC	ENDSTF(KPT+6)=Q(KK+6)
CC	ENDSTF(KPT+7)=0
CC	ENDSTF(KPT+8)=0 
	DO 535 JJ2=4,12
535	ENDSTF(KPT+JJ2)=Q(KK+JJ2)
	KPT=KPT+13
	ENDSTF(KPT)=0

	RS=Q(LL+1)
	IF(RS.LE.4)GO TO 30
	R4=Q(LL+2)
C  SAVE THE STAFF NUM. IN R4
	IF(RS.NE.18)GO TO 7011
335	R3=R3+6
	KK=LL
	KKK=KKK+1
	GO TO 435
7011	RS=CODEN(KPN,KKK+1,Q,LL)
	IF(RS.LE.4)GO TO 30
	IF(Q(LL+2).NE.R4)GO TO 30
	IF(RS.EQ.18)GO TO 335
30	JPQ=KPN(NA+1)-KPN(NA)+JPQ
	IF(NA.LT.I)GO TO 131
C  END OF LOOP ****************

	CALL PSHFT(I)
	RS=RT
	LL='J'
	R4=0
	R5=200
	NA=L
	L=KP-1 
	CALL PTMOVE(RN,KWDS(1))

C  START LAST LOOP *******
	DO 47 JJ2=1,KP
	LL=KWDS(JJ2)
	AA=RN(LL+1)
	IF(AA.NE.10.AND.AA.NE.16)GO TO 1047
CN	IF(AA.NE.10.AND.AA.NE.16)GO TO 347
	DO 147 NN=JJ2+1,KP
	MM=KWDS(NN)
	IF(RN(MM+1).NE.16)GO TO 147
C  FOUND THE NEXT TEXT AFTER TEXT OR NUMB.
	IF(RN(MM).EQ.8)GO TO 47
C  JUMP IF POS. IS ALREADY TAKEN CARE OF.
	IF(AA.EQ.10)GO TO 247
C NEXT FOR TEXT FOLLOWING TEXT
	IF(ABS(RN(MM+4)-RN(LL+4)).GE.4)GO TO 47
C JUMP IF ON DIFF. VERT. PLANE.
	AA=(RN(LL+9)+4.)*RSTJ2*RN(LL+5)+RN(LL+3)
C  SETS MINIMUM SPACE.
	IF(RN(MM+3).LT.AA)RN(MM+3)=AA
	GO TO 47
247	IF(ABS(RN(MM+4)-RN(LL+4)).GT.6)GO TO 47
C  CHECKS VERT. POS.
	AA=RN(LL+4)+7
	IF(RN(MM+4)-AA.LT.0)RN(MM+4)=AA
C  MOVE WORD TO RIGHT OF NUMBER IF IT WAS TOO CLOSE
	GO TO 47
147	CONTINUE
	GO TO 47
CN347	IF(AA.NE.5)GO TO 1047
C TO IMPROVE SLUR PARAMETERS
CN	R8=RN(LL+8)
CN	IF(RN(LL).LT.6)R8=0
CN	IF(R8.GT.0)GO TO 47
C  JUMP IF A BRACKET
CN	R=RN(LL+6)

CN	DO 647 NN=JJ2+1,KP
CN	MM=KWDS(NN)
C  THIS IS TO FIND SLURS AT END OF OLD LINES AND EXTEND THEM
CN	IF(RN(MM+1).NE.4)GO TO 647
C FIND A BAR LINE
CN	IF(RN(MM+3).GT.199.)GO TO 647
C  IGNORE LAST BAR OR LINE.
CN	IF(RN(MM).GT.2)GO TO 647
CN	AA=ABS(RN(MM+3)-R)
CN	IF(AA.GT.1.)GO TO 647
CN	RN(LL+6)=R+4
CN	GO TO 47
CN647	CONTINUE

CN	R7=RN(LL+7)
CN	R9=R-RN(LL+3)+(R8+1.)*2.
CN	IF(R9.GT.7)GO TO 47
C  NO WORK NEEDED.  IT'S LONG ENOUGH
CN	IF(RN(LL).GT.5)RN(LL+8)=-1
CN	R=1.
CN	IF(R7.LT.0)R=-R
CN547	RN(LL+4)=RN(LL+4)+R
CN	RN(LL+5)=RN(LL+5)+R
C  WERE +AA ↑↑↑↑↑
CN	RN(LL+7)=R
CN	GO TO 47
1047	IF(AA.NE.6)GO TO 47
	IF(RN(LL).LT.7)GO TO 47
	IF(RN(LL+9).GT.200.)RN(LL+9)=0
C ********** FIX THIS IN GETPTS, MOVER.  IT SHOULDN'T MOVE P9 ALWAYS.
47	CONTINUE

2	KWDS(KP)=JPQ
CP	J=1
	IF(KP.GE.250.OR.JPQ.GE.2000)TYPE 20,KP,JPQ
	JJ2=KP+1
C  WRITES 1 EXTRA WORD
CP	JPQ=KB

	DO 12 K=1,KP
CC	N=KWDS(K)
CC	R=RN(N+1)
	R=CODEN(KWDS,K,RN,N)
	IF(R.LE.2)GO TO 22
C  ONCE IT FINDS A REST OR NOTE IT MUST HAVE GONE TOO FAR.
	IF(R.GT.7)GO TO 12
 	IF(R.EQ.5)GO TO 52
	IF(R.NE.4)GO TO 62
	IF(RN(N).GE.4)GO TO 52
62	IF(R.NE.7)GO TO 12
52	A=RN(N+6)
C J HAS NOTE COUNT TO FIND POS OF RIGHT END OF SLUR.
	IF(A.GE.0)GO TO 12
	J=A
	IF(J.EQ.0)J=-1
	B=RN(N+2)
C  B=STAFF NUM.
	JJ=0

	DO 32 KK=K+1,KP
CC	NN=KWDS(KK)
CC	A=RN(NN+1)
	A=CODEN(KWDS,KK,RN,NN)
	IF(A.NE.1)GO TO 32
	IF(B.NE.RN(NN+2))GO TO 32
	D=RN(NN+3)
	JJ=JJ-1
	IF(J.NE.JJ)GO TO 42
	RN(N+6)=D+(D-A)*(RN(N+6)-J)
C FOUND NOTE FOR POSITION.
	GO TO 12
42	A=D
32	CONTINUE
12	CONTINUE
	
22	CALL PUTEXT(NAMX,EXT)
	LCNT=0
	NDPY=0
	RSTFAC(96)=0
C  MUST BE 0 IN MS TO MAKE DISPLAY
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(KWDS,JJ2)
	CALL EXTOUT(RN,JPQ)
	TYPE 101,NAMX,EXT
	NAMX=NAMX+2
CC	IF(IPG)GO TO 6011
	NPG=NPG+1
	IF(NPG.LE.MPG)GO TO 6011
	NPG=1
C RESET, UPDATE FILENAMES
	NAMX=NAMZ+256
	NAMZ=NAMX
6011	NAMQ=NAMX
	CALL FINEXT
	GO TO 100
C IPG=1  = GO BACK TO TRONLY INSTEAD
101	FORMAT(1XA5,'.',A3)
20	FORMAT(' TOO MUCH DATA!!! ',I3,'/250',I5,'/2000')
	END

CC	SUBROUTINE NAMEXT
CC	COMMON /SF/KL,RT,KP,STFSZ,NAME,EXT
CC	COMMON RS,JA,CLEFQ,AA,RQ(6),I(10),KQ,NQ,JQ,JJQ,KBQ,NAQ
CC11	TYPE 12
CC	ACCEPT 1,I
CC	DO 2 K=2,6
CC	IF(I(K).EQ.' ')GO TO 3
CC2	IF(I(K).EQ.'.')GO TO 4
CC	TYPE 10
CC	GO TO 11
CC10	FORMAT(' 5 LTR NAME + EXT ONLY'/)
CC12	FORMAT(' TYPE FILE NAME -- '$)
CC3	REREAD 99,NAME
CC	RETURN
CC4	GO TO(1,5,6,7,8,9),K
CC1	FORMAT(10A1)
CC55	FORMAT(2A1,A3)
CC66	FORMAT(A2,A1,A3)
CC77	FORMAT(A3,A1,A3)
CC88	FORMAT(A4,A1,A3)
CC99	FORMAT(A5,A1,A3)
CC5	REREAD 55,NAME,K,EXT
CC	RETURN
CC6	REREAD 66,NAME,K,EXT
CC	RETURN
CC7	REREAD 77,NAME,K,EXT
CC	RETURN
CC8	REREAD 88,NAME,K,EXT
CC	RETURN
CC9	REREAD 99,NAME,K,EXT
CC	END